 PAG
********************
*      SEG5
********************

]segnum = #$0500 ;current segment number

 ORG $E0C800

MSGVERS
 DFB CR,CR,CR
 ASC "     (R)"
 DFB CR
 ASC "ProDev  DDT16 Version 1.7.1"
 DFB CR,CR
 ASC "28-May-2005 17:30"
 DFB CR,CR
 ASC "BY: Chuck Kelly"
 DFB CR,CR
* ASC "Christ is the answer!"
* Amazing how many people were afraid of this little statement.
* Unfortunately for them, their fears do not change reality.
 DFB CR,CR,CR,CR,CR,CR,CR,CR,CR,CR,CR,CR,CR
 DFB EOT


* Copyright message for displaying in break window

MSGCOPYR
 DFB CR,CR,CR
 ASC "This Program"
 DFB CR
 ASC "released to"
 DFB CR
 ASC "Public Domain"
 DFB CR
 ASC "      by:"
 DFB CR
 ASC "  ProDev, Inc"
 DFB CR,CR
 ASC "   No rights"
 DFB CR
 ASC "   reserved"
 DFB CR,CR,EOT


*-------------------------------------------------
COMMANDS

* SEGMENT 0
 ASC "TRSTEXERDRJSRTONOF"

* SEGMENT 1
 ASC "SBHBRBRHRAMMMDM ? QU*** L LI"

* SEGMENT 2
 ASC "MOET"

* SEGMENT 3
 ASC "MA"

* SEGMENT 4
 ASC "TS> KESSSDMWPW"

* SEGMENT 5
 ASC "P=PCA=X=Y=S=D=B=E=I=Q=GO"
ComdEnd

*-------------------------------------------------
* Command address table

* The following commands are in segment 0

COMDJUMP
 DA COMDTR-1
 DA COMDST-1
 DA COMDEX-1
 DA COMDER-1
 DA COMDDR-1
 DA COMDJS-1
 DA COMDRT-1
 DA COMDON-1
 DA COMDOFF-1

* The following commands are in segment 1

CMNDSEG1
 DA COMDSB-1
 DA COMDHB-1
 DA COMDRB-1
 DA COMDRH-1
 DA COMDRA-1
 DA COMDMM-1
 DA COMDMD-1
 DA CMDMENU-1
 DA CMDMENU-1
 DA COMDQU-1
 DA COMDDAST-1
 DA COMDDAST-1
 DA COMDLI-1
 DA COMDLI-1

* The following commands are in segment 2

CMNDSEG2
 DA COMDMO-1
 DA COMDET-1

* The following commands are in segment 3

CMNDSEG3
 DA COMDMA-1

* The following commands are in segment 4

CMNDSEG4
 DA COMDTS-1
 DA COMDSKIP-1
 DA COMDKEY-1
 DA COMDSS-1
 DA COMDSD-1
 DA COMDMW-1
 DA COMDPW-1

* The following commands are in segment 5

CMNDSEG5
 DA COMDPE-1
 DA COMDPC-1
 DA COMDAE-1
 DA COMDXE-1
 DA COMDYE-1
 DA COMDSE-1
 DA COMDDE-1
 DA COMDBE-1
 DA COMDEE-1
 DA COMDIE-1
 DA COMDQE-1
 DA COMDGO-1

*-------------------------------------------------
* Table used to find segment number of command

ComdSegN
 db CMNDSEG1-COMDJUMP-1,0 ; Index range, segment 0
 db CMNDSEG2-COMDJUMP-1,1 ; Index range, segment 1
 db CMNDSEG3-COMDJUMP-1,2
 db CMNDSEG4-COMDJUMP-1,3
 db CMNDSEG5-COMDJUMP-1,4
CmdTblSiz = *-ComdSegN

*-------------------------------------------------
* MSGFLAGS

MSGFLAGS
 DFB CR
 ASC "Flags  NV1BDIZC"
 DFB CR
 ASC "Status "
 DFB EOT

* Flags for 16 bit mode

MSGFLG16
 DFB CR
 ASC "Flags  NVMXDIZC"
 DFB CR
 ASC "Status "
 DFB EOT

* MSGFENT

MSGFENT
 DFB CR
 ASC "ENTER "
 DFB EOT

*--------------------
* MSGCRES

MSGCRES
 DFB CR
 ASC "(return,esc) ?"
 DFB EOT

*-------------------
* MESSAGE "BREAKPOINT"

MSGBREAK
 ASC "** BREAK **"
 DFB CR
 DFB EOT


****************************************
* THIS POINT MUST BE $CA00 OR ABOVE.
****************************************

 ERR *-1/$E0CA00
 DS $E0CA00-*,$FF


**********************************
*       GET  COMMAND
**********************************

S_GETCOM = ]segnum ;segment of this command
GETCOMCR
 LDA TFLAG ;is Trace mode on?
 BNE GETCOM ;if no then skip <CR>
 JSR TRANSFR5 ;DO <CR>
 DFB CROUTC ;code

 LDA #":" ;load acc with ascii ":"
 STA PROMPT ;store prompt

GETCOM JSR TRANSFR5 ;get input line no <CR>
 DFB GETLNC ;code byte
 BCS GETCOMCR ;if <esc> key pressed

* assumes X=0 if only a return is entered
 INX ;inc. char. count
 LDY #00 ;clear Y
 JSR TRANSFR5 ;get char
 DFB GETCHRC ;code byte
 BNE :GETC ;get the command

* only a CR was entered so check TRACE flag
 LDA TFLAG
 BEQ GETCOM ;if TFLAG not set

 PEA TRACE1-1 ;address of command
 PEA S_TRACE1 ;segment number of command
 JMP JUMPSEG5 ;if TFLAG set

:GETC STA LETTER1
 LDA IN,Y ;get next letter of command
 INY
 DEX ;sets ZFLAG when buffer empty
 BNE :LTR2
* Only one letter was entered so fill with space in case it was
* a single letter command
 LDA #$A0
 INX
 DEY ;point at CR so GETCHR0 works in list routine
:LTR2 STA LETTER2
 STX XBUFF
 LDX #ComdEnd-COMMANDS-2 ;pointer to last command in table

 memory16
:CHECK CMP $C800 ; disable DDT RAM
 lda COMMANDS,X
 STA $CF00 ; enable DDT RAM
 cmp LETTER1 ; does this match the user input?
 beq :FOUND ; if yes
 DEX ; if no, try next command
 DEX
 BPL :CHECK
 memory8

 LDA #INVCOM ;invalid command error number
 JSR ERRBEEP
 JMP GETCOMCR

 MX %01
* put address of command on stack
:FOUND cmp $C800 ; disable DDT RAM
 LDA COMDJUMP,X ; get address
 CMP $CF00 ; enable DDT RAM
 PHA ; command address
 memory8 ; 8 bit memory

 LDA #0
 STA TFLAG ;clear TFLAG

* put segment number of command on stack

 txa  ; command pointer
 ldx #0

:GetSegN cmp $C800 ; disable DDT RAM
 cmp ComdSegN,X ; command in this range ?
 sta $CF00 ; enable DDT RAM
 blt :thisSeg ; if yes
 inx
 inx
 cpx #CmdTblSiz ; end of table ?
 blt :GetSegN ; if no
 bra :seg5 ; if yes, command must be in seg 5
:thisSeg cmp $C800 ; disable DDT RAM
 lda ComdSegN+1,X ; get segment number of command
 cmp $CF00 ; enable DDT RAM
 pha
 pha  ; JumpSeg needs word data
:toComm sec ; set C=1 if not SEG 5 command
 bra :goComm
:seg5 clc ; set C=0 for SEG 5 command

:goComm PHP ; save C
 LDX XBUFF ; restore
 JSR TRANSFR5 ; get next character
 DFB GETCHRC ; code
 STA LETTER1 ; save
 PLP ; restore C

 INX
 DEX ;set Z bit by X
 BCC :STAY5 ;command in SEG 5
 JMP JUMPSEG5 ;go to the command in other segment

:STAY5 RTS ;use RTS to pull address and go to command

*------------------------------
* Display the version number
* Set condition code C as follows:
* C = 1 enter DDT
* C = 0 return to user after init

DISVERS
 PEA MSGVERS ;message location
 JSR WRITE5 ;display

 BIT STRT2FLG ;DID WE ENTER AT START2 ?
 BMI :ENTER ;IF NO

 JSR TRANSFR5 ;Setup GS vectors, restore text screen
 DFB RESTSTUFC ;code

* We are doing an RTL so enable the button interrupt.
 LDA #$FF
 STA STRT2FLG ;RESET FLAG
 STA VIAIFR ;DISABLE OLD INTERRUPT FLAGS
 LDA #%10000010 ;ENABLE BUTTON ONLY
 STA VIAIER

* User entered to initialize the DDT and return.
* Check for condition #2 return.
 LDA ACC ;get contents of accumulator at entry
 CMP #2 ;was condition #2 selected ?
 BNE :CK3 ;if no
* Set return condition #2, button & BRKs not enabled, writing to card is
* allowed, accessing vectors is OK.
 LDA #%00000010 ;Disable button
 STA VIAIER
 LDA #%11111110 ;CB2 HI, CB1 POS EDGE, CA2 HI, CA1 NEG EDGE
 BRA :RTSET

* Check for condition #3 return.
:CK3 CMP #3 ;was condition #3 selected ?
 BNE :DEFALT ;if no
* Set return condition #3, button is only way back into card.
* accessing vectors is OK, card is write protected.
 LDA #%11011100 ;CB2 LOW, CB1 POS EDGE, CA2 LOW, CA1 NEG EDGE
 BRA :RTSET

* Set default return condition, button, BRKs, writing to card all enabled
* accessing vectors $FFE8-$FFFF turns on /INH flip-flop.
:DEFALT LDA #%11011110 ;CB2 LOW, CB1 POS EDGE, CA2 HI, CA1 NEG EDGE
 STA VIAPCR ;its OK to set this condition in non 0 SEG

:RTSET CLC
 RTS

:ENTER SEC
 RTS

*---------------------------------
*  Display the copyright notice in the breakpoint window

DSCOPYR JSR TRANSFR5 ;display the break window to set the window
 DFB DISBRKWC ;code

 PEA MSGCOPYR ;message location
 JSR WRITE5 ;display

 JSR TRANSFR4 ;set DR window
 DFB WINDDRC ;code
 RTS

*---------------------------------
* Write text to the display device
* The address of the text is on the stack

* THIS ROUTINE MUST BE ABOVE $CF00

WRITE5 STY YBUFF ;SAVE
 LDY #0
WRITLOP5
 CMP $C800 ;disable DDT RAM
 LDA (3,S),Y ;get character to display
 CMP $CF00 ;enable DDT RAM
 INY ;next character
 CMP #EOT ;finished?
 BEQ WRITDON5 ;if yes
 JSR TRANSFR5 ;display character
 DFB COUTC ;code
 BRA WRITLOP5 ;loop until done

WRITDON5
 MEMORY16
 PLA ;get return address
 STA 1,S ;free parameter space
 MEMORY8
 LDY YBUFF ;RESTORE
 RTS

*-------------------------------------------------
* Display break

DISBREAK PEA MSGBREAK ;address of message
 JSR WRITE5 ;DISPLAY
 RTS

*-------------------------*
*       Command P=
*-------------------------*

COMDPE
 BEQ COMDPP ;if no number follows
 JSR TRANSFR5 ;CHECK FOR HEX AND READ
 DFB CHKREADC ;code
 BCS COMDPP ;IF NOT HEX
 STA STATUS ;CHANGE STATUS
PPGETCOM
 JMP GETCOMCR

* Command is P= with no number, change individual flags,
* display the flags

COMDPP BIT EMULATE ;Native mode ?
 BMI :DO8 ;If emulation mode then display 6502 flags
 PEA MSGFLG16 ;message for 65816 flags
 BRA :SKIP8
:DO8 PEA MSGFLAGS ;message for 6502 flags
:SKIP8 JSR WRITE5 ;display flags

* display the current status
 LDX #8
 LDA STATUS
DISPSTAT
 ASL
 PHA
 BCS FLAGON
 LDA #"0"
 BNE DISPIOR0
FLAGON LDA #"1"
DISPIOR0
 JSR TRANSFR5
 DFB COUTC ;CODE
 PLA
 DEX
 BNE DISPSTAT

* Display "ENTER"
 PEA MSGFENT ;message location
 JSR WRITE5 ;display it

 LDA #$A0
 STA PROMPT
 JSR TRANSFR5 ;GET INPUT NO CR
 DFB GETLNC ;CODE
 BCS PPGETCOM ;if "esc" key
 LDY #00 ;8 BITS + 1

* Recognizes only 0 and 1, everything else is treated as space

NEXTFLAG
 LDX IN,Y
 INY
 CPY #9
 BGE PPGETCOM
 CPX #"1"
 BNE CHKZERO ;IF NOT 1
 TYA
 TAX
 LDA #0
 SEC
MOVEONE ROR
 DEX
 BNE MOVEONE
 ORA STATUS
SAVESTAT
 STA STATUS
 BRA NEXTFLAG
CHKZERO CPX #"0"
 BNE CHKRETRN
 TYA
 TAX
 LDA #$FF
 CLC
MOVEZERO
 ROR
 DEX
 BNE MOVEZERO
 AND STATUS
 BRA SAVESTAT
CHKRETRN
 CPX #CR
 BEQ OKEXIT5
 BNE NEXTFLAG

*-----------------------*
*  Command PC=
*-----------------------*

COMDPC JSR TRANSFR5 ;DOES DATA FOLLOW
 DFB GETCHRC ;code
 BEQ TOBP5A ;IF BAD PARAMETER
 JSR GETPPC ;LOAD PC WITH DATA
 BCC OKEXIT5 ;IF DATA WAS OK	
TOBP5A
 JMP BPERR5 ;BAD PARAMETER ERROR

OKEXIT5 MEMORY8 ;SET 8 BIT DATA
 JMP GETCOMCR

GETPPC JSR CKREAD16 ;CHECK FOR HEX AND READ
 BCS :ERR ;IF NOT HEX
 STA PCLO ;CHANGE 16 BITS OF PC
 STA MEMLOW ;SAVE 16 BITS
 MEMORY8 ;SET 8 BIT DATA

 LDA MEMPBR ;USE JUST ENTERED BANK
 STA PBR
 STA PBR8 ;special PBR for 8 bit code in non zero banks

 CLC ;NO ERRORS
:ERR RTS

*-----------------------*
*  Command A=
*-----------------------*

COMDAE JSR CKREAD16 ;CHECK FOR HEX AND READ
 BCS TOBP5A ;IF NOT HEX
 STA ACC ;CHANGE ACC
 BRA OKEXIT5 ;TO GETCOMCR

*-----------------------*
*  Command X=
*-----------------------*

COMDXE JSR CKREAD16
 BCS TOBP5A
 STA XREG ;CHANGE XREG
 BRA OKEXIT5

*-------------------------*
*  Command Y=
*-------------------------*

COMDYE JSR CKREAD16
 BCS TOBP5A
 STA YREG ;CHANGE YREG
 BRA OKEXIT5

*-------------------*
*  Command S=
*-------------------*

COMDSE JSR CKREAD16
 BCS TOBP5
 STA STACK ;CHANGE STACK
 MEMORY8 ;SET 8 BIT DATA
 JSR TRANSFR5 ;UPDATE WINDOWS
 DFB DISFMESC ;code
 JSR TRANSFR5 ;SET DR WINDOW
 DFB WINDDRC ;Eode
 BRA OKEXIT5

*-----------------------*
*  Command  D=
*-----------------------*

COMDDE JSR CKREAD16
 BCS TOBP5
 STA DREG ;CHANGE DIRECT REGISTER
 BRA OKEXIT5

*----------------------*
*   Command  B=
*----------------------*

COMDBE JSR TRANSFR5 ;READ HEX INPUT
 DFB CHKREADC ;code
 BCS TOBP5 ;IF ERROR
 STA DBR ;CHANGE DATA BANK REGISTER
 BRA OKEXIT5

*----------------------*
*   Command  E=
*----------------------*

COMDEE JSR TRANSFR5 ;READ HEX INPUT
 DFB CHKREADC ;code
 BCS TOBP5 ;IF ERROR
 BEQ :EIS0 ;IF E=0
 LDA #$80 ;IF E=1
:EIS0 STA EMULATE ;SET EMULATION FLAG
TOOKEX5 BRA OKEXIT5

*----------------------*
*   Command  I=
*----------------------*

COMDIE JSR TRANSFR5 ;READ HEX INPUT
 DFB CHKREADC ;code
 BCS TOBP5 ;IF ERROR
 BEQ :IIS0 ;IF I=0
 LDA #$04 ;IF I=1
:IIS0 STA Iflag ;SET Iflag
 BRA TOOKEX5

*-----------------------*
*  Command Q=
*-----------------------*

COMDQE JSR TRANSFR5 ;CHECK FOR HEX AND READ
 DFB CHKREADC ;code
 BCS TOBP5 ;IF NOT HEX
 PHA
 AND #$80 ;isolate speed bit
 TSB SPEEDREG ;set high speed if Qbit7=1
 EOR #$80 ;invert bit
 TRB SPEEDREG ;set slow speed if Qbit7=0
 PLA
 AND #$7F ;isolate shadow bits
 TSB SHADOW ;set desired bits
 EOR #$7F ;invert bits
 TRB SHADOW ;clear desired bits
 BRA TOOKEX5 ;TO GETCOMCR

*--------------------------------*
*   Command GO [A] - RUN PROGRAM *
*--------------------------------*

COMDGO BEQ GOATPC ;NO PC FOLLOWS, RUN AT CURRENT PC
 JSR GETPPC ;LOAD PC WITH ADDRESS
TOBP5 BCS BPERR5 ;IF NOT VALID ADDRESS

* Trece 1 instruction then go

GOATPC SEC
 ROR GOFLAG ;set GO flag
 JSR TRANSFR5 ;RUN USERS PROGRAM
 DFB STEP1C ;code <NO RETURN>

*-------------------------------------------------
BPERR5 LDA #BADPAR ;bad command parameters error number
TOERR5 JSR ERRBEEP ;ERROR
 JMP GETCOMCR

*-------------------------------------------------
* Interrupt Analyze
*-------------------------------------------------

S_INTANL = ]segnum ;segment number of command
INTANLYZ LDA #$73
 CMP TEMP ;did we get here from BRKVEC ?
 BNE :V03FB ;if not
 PLA ;get bank from JSL

* We got here from the GS BRK vector. The registers have been saved by the GS.
* Get the registers from GS RAM and put them in DDT RAM.
 MX16
 PEA #$C900
 PLD  ;make our RAM direct page
 LDY #0
* LDAL $E10108
 LDA [BRKSTUF-$E0C900],Y ;Acc
 STA ACC
 INY
 INY
* LDAL $E1010A ;X reg
 LDA [BRKSTUF-$E0C900],Y
 TAX
 INY
 INY
* LDAL $E1010C ;Y reg
 LDA [BRKSTUF-$E0C900],Y
 STA YREG
 INY
 INY
* LDAL $E1010E
 LDA [BRKSTUF-$E0C900],Y
 TCS ;restore to user's stack
 INY
 INY
* LDAL $E10110
 LDA [BRKSTUF-$E0C900],Y
 STA DREG
 INY
 INY
* LDAL $E10112
 LDA [BRKSTUF-$E0C900],Y
 MEMORY8
 XBA
 STA DBR
 INY
 INY
* LDAL $E10114 ;Emulation flag
 LDA [BRKSTUF-$E0C900],Y
 STA TEMP+2
 INY
 INY
 INY
 INY
* LDAL $E10118 ;Mstate register
 LDA [BRKSTUF-$E0C900],Y
 ROR ;set Carry with CXROM status bit
 ROR CXSTATUS ;save CXROM status
 ASL ;insure CXROM is off
 STA GS_STATE ;restore GS state register
 INY
 INY
* LDAL $E1011A ;Speed register
 LDA [BRKSTUF-$E0C900],Y
 STA SPEEDREG ;restore GS speed register

 LDY DREG
 PHY
 PLD  ;restore D
 LDY YREG ;restore Y
 LDA TEMP+2 ;User's emulation flag
 ROR
 XCE  ;restore user's state
 lda #$80
 sta Tflag ; force Trace mode on BRK

:V03FB PLA ;get user's status
 STA STATUS ;save user's status
 PLA ;user's pclo
 STA PCLO
 PLA ;user's pchi
 STA PCHI

* User's stack is at pre-interrupt position if user was in emualtion mode
* so it is safe to switch to native mode.
* Set native mode
 CLC
 XCE
 ROR EMULATE ;save emulation mode
 BMI :NOPBR ;if no PBR
 PLA ;get PBR if it was on stack
 STZ PBR8 ;clear PBR8 if native mode
 BRA :SAVEPBR
:NOPBR LDA PBR8 ;get 8 bit PBR
:SAVEPBR STA PBR

 INDEX16
 STX XREG
 STY YREG

* Is our NMI the source of the interrupt ?
 LDA TEMP ;get return address
 CMP #$FD ;did we get here from $03FB ?
 BNE :OURINT ;if no, MUST have been a BRK
 LDA VIAIFR ;check our VIA
 BMI :OURINT ;if it is our NMI
 SEP #$40 ;*** set V to indicate GS NMI ***
 JMP :NOTOUR ;if not our interrupt

*-------------------------------------------------
* The interrupt is ours so trap it.

:OURINT LDA #%01111111 ;DISABLE ALL INTERRUPTS
 STA VIAIER ;ALSO CLEARS BIT 7 OF VIAIFR

* Restore the interrupt vectors & set-up TEMP for SAVESTK RTS location

 MX8
 LDX #BREAK-1 ;default to BRK handler
 LDA TEMP ;get our return address of INT vector
 CMP #$FD ;did we come from $03FB ?
 BNE :NONMI ;if not
 LDX #NMICONT-1 ;go to NMI handler
:NONMI STX TEMP ;set up low byte
 LDA SLOTCN ;routines are in slot ROM
 STA TEMP+1 ;set up hi byte

 LDX #3
 BRA :SKIP ;3FB vector is only 3 bytes
:REPEAT LDA V0003FB,X
 STAL $0003FB,X
:SKIP LDA VE10070,X
 STAL $E10070,X
 DEX
 BPL :REPEAT ;until X < 0
:ENDI MX16

 PEA SAVESTK-1 ;address of routine
 PEA S_SAVEST ;segment of routine
 JMP JUMPSEG5 ;transfer segments

 MX %11

*-------------------------------------------------
* The interrupt is not ours or is not a BRK so restore the stuff that we
* have messed up and return control to the GS interrupt handler.
* Enter with: V = 1 if interrupt was caused by non DDT NMI.

:NOTOUR JSR TRANSFR5 ;save ACC & Xreg to seg1 RAM
 DFB AX2S1_AC ;code

* setup SEG 7 EX routine
 LDA #$07 ;low byte needed to turn CXROM on
 LDX CXSTATUS ;WAS CXROM ON?
 BMI :SETCX ;IF YES
 LDA #$06 ;low byte needed to keep CXROM off
:SETCX PHA ;for IOCX7 switch
 LDA ACC
 PHA ;for IOACC restore byte

* Set IOPBR & IOPC to go the the proper GS interrupt handler
 INDEX16
* V=1 if a GS NMI was the source of the interrupt
 BVC :GSINT ;goto GS interrupt handler
* Go the the GS NMI handler
 LDA #0 ;use program bank 0
 LDY V0003FB+1 ;pc of NMI handler
 BRA :SETIO
* Go to the GS interrupt handler
:GSINT LDA VE10070+3 ;program bank
 LDY VE10070+1 ;pc of interrupt handler
:SETIO PHA ;push IOPBR
 PHY ;push IOPC

 INDEX8
******************************************
* !!! CAUTION !!! SEGMENT DEPENDENT CODE *
******************************************
 LDX SLOTN0
 LDA #%01110110 ;RAM7, ROM6
 STA SEGMBASE,X
 PLA
 STA IOPCLO
 PLA
 STA IOPCHI
 PLA
 STA IOPBR
 PLA
 STA IOACC ;set user's ACC
 PLA
 STA IOCX7 ;set user's CXROM
 LDA #$28 ;PLP opcode
 STA IORTI ;replace RTI with PLP
 LDA #$5C ;JML opcode
 STA IORTL ;replace RTL with JML
******************************************
* !!! CAUTION !!! SEGMENT DEPENDENT CODE *
******************************************
 LDA #%00000110 ;RAM0, ROM6
 STA SEGMBASE,X ;RAM 0 & ROM 6

 LDA EMULATE
 ROL
 XCE ;restore user's mode so stack works the same

 PLA ;adjust stack to pre interrupt position
 PLA
 PLA
 PLA
 PLA

* Put user's stack back to post interrupt state
 LDA EMULATE ;test emulate flag (use LDA to keep V flag)
 BMI :NOPBR2 ;if no PBR was on stack
 LDA PBR
 PHA ;restore PBR on stack
:NOPBR2 LDA PCHI ;restore PC
 PHA
 LDA PCLO
 PHA
 LDA STATUS ;pre interrupt STATUS
 PHA ;restore status

* Post interrupt status is pulled by PLP in SEG7 IO code
 LDA TEMP+2 ;post interrupt STATUS
 ORA #$04 ;make sure I flag is set
 PHA ;pulled in SEG7 IO code

 XCE ;back to native mode & set C for TOC0N0IO
 LDX SLOTN0 ;set X for TOC0N0IO to use

 INDEX16
 LDY YREG ;restore

 LDA DBR
 PHA ;for immediate restoration
* Restore VIA
 LDA #%11011110 ;CB2 low, CB1 pos edge, CA2 hi, CA1 neg edge
 STA VIAPCR ;replace Apple's vectors

 LDA #USERINT ;low byte
 STA TOSLOT ;setup (jmp)
 PLB ;restore data bank register
 JMP (TOSLOT) ;goto TOC0N0IO via slot space code

 MX %11


*----------------------------------*
*       SUBROUTINES                *
*----------------------------------*

* READS 16 BIT HEX INPUT INTO ACC., SETS CARRY IF ERROR

CKREAD16
 JSR TRANSFR5 ;DO CHKREAD
 DFB CHKREADC ;code
 BCS :ERR ;IF ERROR
 MEMORY16 ;SET 16 BIT ACC
 MX %11 ;TELL MERLIN 16 TO STICK WITH 8 BITS
 LDA LETTER1 ;LOAD 16 BIT HEX
:ERR RTS

*----------------------------------------
* Goto slot #1 Pascal 1.1 routines
* Returns from slot space directly to calling routine.
* A, X, Y all trashed.
* Note !!! The following routine must always be called via TRANSFRx so that
* upon returning from the I/O routines the proper segment will be selected.

PASCALIO LDX SLOTCN
 PHX
 LDX #TOPASCAL
 PHX
 BIT IOMODE ;bit 7=1 if slot2, 6=1 if slot1
 BPL :SLOT1
 LDX #$C2 ;slot 2
 LDY #$20
 BRA :GO
:SLOT1 LDX #$C1 ;slot Cn
 LDY #$10 ;slot n0
:GO RTS ;goto slot space routine

*-------------------------------------------------
* Beep and indicate where error is and display error number

ERRBEEP PHA ;SAVE ERROR NUMBER
 TYA
 BNE YNOTZER0
 LDA #1
YNOTZER0
 TAX ;IF Y=0 THEN 256 SPACES PRINTED
 JSR TRANSFR5 ;PRINT SPACES
 DFB PRBL2C ;CODE
 LDA #"^"
 JSR TRANSFR5 ;INDICATE WHERE ERROR WAS
 DFB COUTC ;CODE
 JSR TRANSFR5 ;PRINT "ERR" RING BELL
 DFB PRERRC ;CODE

 PLA ;GET ERROR NUMBER
 JSR TRANSFR5 ;PRINT ERROR NUMBER
 DFB PRBYTEC ;code
 RTS

*------------------------------------
* Check for access to no access renge
*------------------------------------

CKACCES BIT NOACCESS ;N RANGES ACTIVE ?
 BPL :END ;IF NOT
 LDA TFLAG ;TRACE MODE ?
 BEQ :END ;IF NOT

 LDX #30
:CHECK LDA PROTADR,X ;GET PW TYPE
 CMP #"N" ;IS IT NO ACCESS ?
 BNE :NEXT ;IF NO
 JSR CHKRANG ;IS PC IN RANGE ?
 BCS :IN ;IF YES
 LDA NUMDISP ;# BYTES IN INST-1
 BEQ :NEXT ;ONE BYTE INSTR HAS NO EFF ADRS
 LDA MODE ;# MODE ?
 BEQ :NEXT ;# MODE NO EFF ADRS
 CMP #AM_A_NE*2 ;Address Mode = A with No Effective address?
 BEQ :NEXT ;no effective address

* Is EFFADRS in range ?
 LDA PROTADR+1,X ;GET PBR
 CMP EFFADRS+2 ;COMPARE WITH EFF PBR
 BNE :NEXT ;IF NOT IN RANGE
 LDA EFFADRS+1 ;EFF PCHI
 CMP PROTADR+2,X ;COMPARE WITH LOWER LIMIT PCHI
 BLT :NEXT ;NOT IN RANGE
 BNE :CHKUP ;CHECK UPPER LIMIT
 LDA EFFADRS ;EFF PCLO
 CMP PROTADR+3,X ;COMPARE WITH LOWER LIMIT PCLO
 BLT :NEXT ;NOT IN RANGE
 LDA EFFADRS+1 ;EFF PCHI
:CHKUP CMP PROTADR+4,X ;COMPARE WITH UPPER LIMIT PCHI
 BLT :IN ;IN RANGE
 BNE :NEXT ;NOT IN RANGE
 LDA EFFADRS ;EFF PCLO
 CMP PROTADR+5,X ;COMPARE WITH UPPER LIMIT PCLO
 BLT :IN ;IN RANGE
 BEQ :IN ;IN RANGE
:NEXT SEC
 TXA ;GOTO NEXT PROTADR
 SBC #6
 TAX
 BPL :CHECK
 BMI :END ;NOT IN NO ACCESS RANGE

* In no access range so display message & stop trace

:IN JSR TRANSFR5 ;DISPLAY "NO ACCESS HALT"
 DFB NOACMSGC ;code
 LDA #1 ;STOP TRACE
 STA TCOUNT
 STZ TCOUNT+1
:END RTS


******************************
* Part of COMDRT
* Come here from "RT" or because of T range in "PW", after running the
* JSR/JSL instruction
* Note ! Stack is treated as native. Will fail if user's code is 8 bit JSR
* & stack is at $101 or $100 before JSR.

SETUPRT LDA #$80
 TSB RTBRKFLG ;set bit 7 = 1
 lda RTstatus
 sta STATUS ; restore user's I flag
 MX16 ;16 BIT
 LDX STACK ;current stack

* Get return address from stack
 LDAL $1,X ;GET RETURN ADDRESS
 SEC
 SBC #2 ;POINT TO JSR OPCODE
 STA LOWADD

* was JSR or JSL used
 LDA RTSTACK ;realtime STACK that was saved before JS
 SEC
 SBC STACK ;how many bytes were pushed
 CMP #3 ;was JSL used?
 BLT :JSRUSED ;if no
 DEC LOWADD ;if yes, point to JSL opcode
 MEMORY8
 BIT EMULATE ;is user in native mode?
 BPL :JSLOK ;if yes
* user is doing "RT" or "T" range JSL while in 8 bit mode. Set V=1 err flag
 SEP #$40 ;set V=1 as error flag
 INDEX8
 RTS  ;leave setup

:JSLOK LDAL $3,X ;get return bank
 STA DBRDDT ;data bank to access

:JSRUSED MX8 ;8 BIT
 ROR RTJSRFLG ;Bit 7=1 if JSL, 0 if JSR (C set by CMP #3)
 LDY #0

* See if a ProDOS MLI call or ProDOS 16 call was the last JSR/JSL executed
* Test for JSR $BF00
 JSR TRANSFR5
 DFB LDAINDYC ;code
 CMP #$20 ;JSR ?
 BEQ :CHKMLI
 CMP #$22 ;JSL ?
 BNE :NOTMLI

 INY
 JSR TRANSFR5
 DFB LDAINDYC ;code
 CMP #$A8
 BNE :NOTMLI

:CHKMLI INY
 JSR TRANSFR5
 DFB LDAINDYC ;code
 BNE :NOTMLI ;IF NOT $00
 INY
 JSR TRANSFR5
 DFB LDAINDYC ;code
 BIT RTJSRFLG ;JSR ?
 BPL :CKMLI
 CMP #$E1 ;was it P16 ?
 BNE :NOTMLI ;if no
 INY
 INY
 BRA :P16 ;if yes
:CKMLI CMP #$BF
 BEQ :MLI ;IF MLI CALL
 BRA :NOTMLI ;if not MLI

:NOTMLI LDY #$FF ;NOT MLI SO PUT BRK AT NEXT INSTRUCTION
 BIT RTJSRFLG ;JSR or JSL
 BPL :MLI ;if JSR
:P16 INY  ;if JSL

* It is a ProDos MLI call, so place a BRK at the instruction
* following the MLI parameters.
:MLI INY
 INY
 INY
 INY ;POINT TO OPCODE OF NEXT INST.
 JSR TRANSFR5 ;GET OPCODE
 DFB LDAINDYC ;code
 BEQ :ISBRK ;IT IS A BRK, SO DON'T ALLOW REAL TIME
 STA RTOPCODE ;SAVE OPCODE
 LDA #0
 JSR TRANSFR5 ;PUT BRK
 DFB STAINDYC ;code
 JSR TRANSFR5 ;VERIFY
 DFB LDAINDYC ;code
 BEQ :CONTINUE ;IF OK

* Brk did not store
:ISBRK CLV  ;clear 8 bit JSL error flag
 RTS ;Z=1 IF ALREADY BRK, Z=0 IF NOT RAM

:CONTINUE
 JSR TRANSFR5 ;START REALTIME
 DFB EXECUTEC ;code (NO RETURN)

* Restore after realtime BRK

RESTRT LDA RTOPCODE ;GET SAVED OPCODE
 LDY #0
 JSR TRANSFR5 ;RESTORE OPCODE AT CURRENT PC
 DFB STAPCIYC ;code

 LDA #$80
 TRB RTBRKFLG ;CLEAR FLAG
 STY PASSFLG ;NOT REALLY A BRK
 BIT COMRTFLG ;IS THIS COMDRT (6=1) or T range (6=0) ?
 RTS

*------------------------------------------------------------
* Is the current PBR, PCHI, PCLO in this protection window limits ?
* SEC if yes

CHKRANG LDA PROTADR+1,X ;GET PBR
 CMP PBR
 BNE :NOTIN ;NOT IN
 MEMORY16
 LDA PROTADR+4,X ;GET UPPER LIMIT OF PC (HI,LO)
 XBA
 CMP PCLO ;COMPARE TO PC
 BLT :NOTIN

 LDA PROTADR+2,X ;get lower limit of PC (HI,LO)
 XBA
 CMP PCLO ;compare to PC
 BLT :IN
 BEQ :IN

:NOTIN CLC
 BRA :EXIT
:IN SEC
:EXIT MEMORY8
 RTS

*----------------------------------------
* Wait for 'return' or 'esc'
* returns C=0 on return, C=1 on esc

WAITCR PEA MSGCRES ;message location
 JSR WRITE5 ;display it

:WAIT JSR TRANSFR5 ;GET INPUT
 DFB RDCHARC ;code
 CMP #ESC ;was it 'esc' ?
 BEQ :EXIT ;if yes (C=1)
 CMP #CR ;was it 'return' ?
 BNE :WAIT ;if no
 CLC ;if yes (C=0)
:EXIT PHP ;save Carry
 JSR TRANSFR5 ;do carriage return
 DFB CROUTC ;code
 PLP ;restore Carry
 RTS

*----------------------------------------
***** GLOBAL SUBROUTINES IN THIS SEGMENT *****

SUBTABL5

DISBREAKC EQU *-SUBTABL5*4+5+$100
 DA DISBREAK-1

LISTC EQU *-SUBTABL5*4+5+$100
 DA LIST-1

DISVERSC EQU *-SUBTABL5*4+5+$100
 DA DISVERS-1

DSCOPYRC EQU *-SUBTABL5*4+5+$100
 DA DSCOPYR-1

PASCALIOC EQU *-SUBTABL5*4+5+$100
 DA PASCALIO-1

ERRBEEPC EQU *-SUBTABL5*4+5+$100
 DA ERRBEEP-1

CKACCESC EQU *-SUBTABL5*4+5+$100
 DA CKACCES-1

SETUPRTC EQU *-SUBTABL5*4+5+$100
 DA SETUPRT-1

RESTRTC EQU *-SUBTABL5*4+5+$100
 DA RESTRT-1

CHKRANGC EQU *-SUBTABL5*4+5+$100
 DA CHKRANG-1

WAITCRC EQU *-SUBTABL5*4+5+$100
 DA WAITCR-1

*****************************************
*  SEGMENT CROSSOVER AREA  *
*****************************************

 LST ON
S5END = $E0CF91-*
 do nolist
 LST OFF
 fin
 ERR *-1/$E0CF91
 DS $E0CF91-*,$FF


******** SAVE THE ACC, X, Y AND P REGISTERS *******
* Returns with MX = 11, saves registers

SAVEAXP5
 PHP ;SAVE STATUS
 MX16
 STX XSAVESEG ;save 16 bits
 STY YSAVESEG ;save 16 bits
 STA ASAVESEG ;save 16 bits
 MX8
 PLA ;GET STATUS
 STA PSAVESEG ;SAVE
 RTS

****** RESTORE THE ACC, X, Y AND P REGISTERS ******
* restores registers

RESTAXP5
 MEMORY8
 LDA PSAVESEG
 PHA
 MX16
 LDX XSAVESEG
 LDY YSAVESEG
 LDA ASAVESEG
 PLP
 RTS
 MX %11

*----------------------------------------
* Do a direct transfer to other segments

JUMPSEG5
 JSR SAVEAXP5
 LDY SLOTN0
 PLA ;pull junk byte from dest. seg
 PLA ;get destination segment
 STA SEGMBASE,Y ;the next inst' will be in new seg
 JSR RESTAXP5 ;restore after xfer from other seg
 RTS ;pull destination address from stack

* TRANSFER TO OTHER SEGMENTS

TRANSFR5

 JSR SAVEAXP5
 MEMORY16
 PLA ;get return address from stack
 INC ;inc to point at code byte & for RTS
 PHA
 MEMORY8
 LDA #5 ;CURRENT SEG #
 PHA
 LDY #0
 LDA (2,S),Y ;GET CODE BYTE
 PHA ;SAVE CODE
 AND #$07 ;STRIP ALL BUT SEG #
 LDY SLOTN0
 STA SEGMBASE,Y ;NEXT INSTR. RUN FROM NEW SEGMENT
* NEW SEGMENT
 PLA ;GET CODE
 PEA RETURN5 ;where to return to
 AND #$F8 ;STIP OFF SEG# LEAVING SUB #
 LSR
 LSR ;LEAVE SUB# MULTIPLIED BY 2
* GET ADDRESS OF SUB FROM SUBTABL & PUSH ON STACK
 TAY
 MEMORY16
 LDA SUBTABL5,Y
 PHA
 BRA RESTAXP5 ;RESTORE REGISTERS, RTS TO SUBROUTINE
 MX %11

* RETURN HERE FROM SUBROUTINE

RETURN5 EQU *-1
 JSR SAVEAXP5
 PLA ;SEG # TO RETURN TO
 LDY SLOTN0
 STA SEGMBASE,Y ;RETURN TO SEGMENT
 BRA RESTAXP5

 DS \,$FF ;PUT OBJECT AT NEXT PAGE
